home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / SCIENTIF / 0428.ZIP / NMR4.BAS < prev    next >
BASIC Source File  |  1985-04-19  |  16KB  |  355 lines
  1. 1  'Program NMR4--Part 4 of NMRCALC
  2. 10 DEFINT I-N
  3. 15 'COMMON IPFLAG,IREAD,FF$
  4. 16 OPEN "scratch.nmr" FOR INPUT AS #1
  5. 17 INPUT #1, IPFLAG: INPUT #1, IREAD: LINE INPUT #1, FF$
  6. 18 CLOSE 1
  7. 30 SCREEN 0,0,0:COLOR 14,4,1:KEY OFF: CLS
  8. 40 DIM BC(7),FZ(8),SLINES(3003,2)
  9. 50 DIM PM(7,7),SH(7)
  10. 60 DIM SF(128,7),E(35),A(35,35)
  11. 70 THRESHOLD1 = 0: THRESHOLD2 = 0
  12. 90 ON ERROR GOTO 60000
  13. 100 CLS:PRINT:PRINT"Display routine for frequencies and intensities.":PRINT
  14. 110 PRINT:PRINT"This is in a menu format; to get menu, press 'M' in command mode.":PRINT:BEEP:PRINT"NOTE:  IT IS NECESSARY TO READ IN THE LINES VIA THE 'R' COMMAND IF AUTO-READ":PRINT"       NOT IN EFFECT!": GOSUB 63999
  15. 120 IF IREAD=1 THEN BF = 0: GOSUB 5100
  16. 200 CLS:PRINT:PRINT"Command ('M' for menu):  ";:GOSUB 500
  17. 210 IF P$ = "E" THEN GOSUB 1000
  18. 215 IF P$ = "W" THEN GOSUB 900: CHAIN "nmr6"
  19. 220 IF P$ = "L" THEN GOSUB 3000
  20. 225 IF P$ = "T" THEN GOSUB 19000
  21. 230 IF P$ = "M" THEN GOSUB 2000
  22. 240 IF P$ = "D" THEN GOSUB 4000
  23. 250 IF P$ = "R" THEN GOSUB 5000
  24. 260 IF P$ = "S" THEN GOSUB 20000
  25. 270 IF P$ <> "Q" THEN 280
  26. 275 CLS: PRINT: PRINT"Returning control to system.": PRINT: END
  27. 280 IF P$ = "U" THEN GOSUB 6000
  28. 290 IF P$ = "C" THEN GOSUB 10000
  29. 300 IF P$ = "P" THEN GOSUB 900: CHAIN "nmr5"
  30. 310 IF P$ = "V" THEN GOSUB 14000
  31. 320 IF P$ = "F" THEN GOSUB 16000
  32. 330 IF P$ = "Z" THEN LPRINT CHR$(12);
  33. 340 IF P$ = "A" THEN GOSUB 18000
  34. 390 GOTO 200
  35. 500 P$ = INKEY$: IF P$ = "" THEN 500
  36. 510 IF ASC(P$) > 90 THEN P$ = CHR$(ASC(P$) - 32)
  37. 520 PRINT P$
  38. 530 RETURN
  39. 800 PRINT:PRINT"Do you desire printed output? ";
  40. 810 A$ = INKEY$: IF A$ = "" THEN 810
  41. 820 IF ASC(A$) > 90 THEN A$ = CHR$(ASC(A$) - 32)
  42. 830 PRINT A$
  43. 840 IF A$ = "Y" THEN IPRINT = 1 ELSE IF A$ = "N" THEN IPRINT = 0                      ELSE BEEP: GOTO 800
  44. 850 RETURN
  45. 900 OPEN "scratch.nmr" FOR OUTPUT AS #1
  46. 901 PRINT #1, IPFLAG: PRINT #1, IREAD: PRINT #1, FF$
  47. 902 RETURN
  48. 1000 CLS:PRINT:PRINT"Returning to main I/O routine.":PRINT
  49. 1010 CHAIN "nmr1"
  50. 2000 CLS:PRINT:PRINT"Command menu:":PRINT
  51. 2005 PRINT "'A'--Alter status of auto-read option."
  52. 2010 PRINT "'C'--Display a particular line."
  53. 2020 PRINT "'D'--Display spectrum parameters."
  54. 2030 PRINT "'E'--Exit back to main I/O routine."
  55. 2035 PRINT "'F'--Check status and/or alter state of pause flag."
  56. 2040 PRINT "'L'--Display spectral lines."
  57. 2050 PRINT "'M'--Display this menu."
  58. 2055 PRINT "'P'--Exit to plotting routines."
  59. 2060 PRINT "'Q'--Quit and return to system control."
  60. 2070 PRINT "'R'--Read needed data from disk (allows resetting of file name)."
  61. 2080 PRINT "'S'--Sort lines by frequency."
  62. 2085 PRINT "'T'--Enter intensity thresholds for line printing."
  63. 2090 PRINT "'U'--Retrieve lines from disk (to get back unsorted lines)."
  64. 2100 PRINT "'V'--Print eigenvalues and eigenvectors."
  65. 2102 PRINT "'W'--Exit to energy level (or Fz) plotting routines."
  66. 2105 PRINT "'Z'--Form feed to printer."
  67. 2110 PRINT:INPUT"Hit return to continue. ",A$: RETURN
  68. 3000 CLS:PRINT:PRINT"Ready to display spectrum lines.  To abort, hit 'Q' during pause message.":PRINT
  69. 3005 GOSUB 800:  IF IPRINT=1 THEN LPRINT:LPRINT:LPRINT"Calculated lines of spectrum.":LPRINT
  70. 3010 PRINT: PRINT NS;"nuclei":PRINT NF;"spin functions":PRINT NL;"spectrum lines": PRINT
  71. 3011 IF THRESHOLD1=0 AND THRESHOLD2=0 THEN 3015
  72. 3012 PRINT"Lower threshold: ",THRESHOLD1
  73. 3013 PRINT"Upper threshold: ",THRESHOLD2
  74. 3015 IF IPRINT=1 THEN LPRINT NS;"nuclei":LPRINT NF;"spin functions":LPRINT NL;"spectrum lines":LPRINT
  75. 3016 IF THRESHOLD1=0 AND THRESHOLD2=0 THEN 3020
  76. 3017 IF IPRINT=1 THEN LPRINT"Lower threshold: ",THRESHOLD1
  77. 3018 IF IPRINT=1 THEN LPRINT"Upper threshold: ",THRESHOLD2
  78. 3020 IC = 0: GOSUB 63999
  79. 3025 A$ = " "
  80. 3030 FOR I = 1 TO NL STEP 15
  81. 3035 IF LEFT$(A$,1) = "q" OR LEFT$(A$,1) = "Q" THEN A$ = "Q"
  82. 3036 IF A$ = "Q" THEN 3050
  83. 3040 GOSUB 3900
  84. 3050 K = I + 14: IF K > NL THEN K = NL
  85. 3060 FOR J = I TO K
  86. 3061 IF THRESHOLD1 = 0 AND THRESHOLD2 = 0 THEN 3069
  87. 3062 SLINE = SLINES(J,2)
  88. 3063 IF SLINE < THRESHOLD1 THEN 3410
  89. 3064 IF SLINE > THRESHOLD2 THEN 3410
  90. 3069 IF A$ = "Q" THEN 3410
  91. 3070 SL = SLINES(J,0): SM = 1000*(SL - INT(SL)): SL = INT(SL): SM = INT(SM+.1)
  92. 3090 PRINT USING "###";SL;:PRINT">";:PRINT USING "###";SM;
  93. 3095 IF IPRINT=1 THEN LPRINT USING "###";SM;:LPRINT">";:LPRINT USING "###";SL;
  94. 3100 F = SLINES(J,1)
  95. 3110 PRINT TAB(8);
  96. 3115 IF IPRINT=1 THEN LPRINT TAB(8);
  97. 3160 PRINT USING "#####.##";F;:PRINT TAB(20);
  98. 3165 IF IPRINT=1 THEN LPRINT USING "#####.##";F;:LPRINT TAB(20);
  99. 3170 F = SLINES(J,2): IF F > .00001 THEN IC = IC + 1
  100. 3200 PRINT USING "##.#####";F;
  101. 3205 IF IPRINT=1 THEN LPRINT USING "##.#####";F;
  102. 3400 PRINT TAB(35);: PRINT USING "####"; J
  103. 3405 IF IPRINT=1 THEN LPRINT TAB(35);:LPRINT USING "####"; J
  104. 3410 NEXT
  105. 3415 IF A$ = "Q" THEN 3430
  106. 3420 GOSUB 63999
  107. 3430 NEXT
  108. 3435 IF A$ = "Q" THEN PRINT: PRINT"Printing routine aborted.  Partial results follow--"
  109. 3440 PRINT:PRINT"Sum of intensities:";:PRINT USING "###.#####";TI
  110. 3445 PRINT
  111. 3450 PRINT IC;"lines have intensity > 0.00001":PRINT
  112. 3460 PRINT"Printing of line intensities completed.": GOTO 63999
  113. 3900 CLS:PRINT:PRINT" Trans";TAB(11);"Freq";TAB(20);"Intensity";TAB(35);"Line#"
  114. 3902 IF I>1 THEN 3910
  115. 3905 IF IPRINT=1 THEN LPRINT:LPRINT:LPRINT" Trans";TAB(11);"Freq";TAB(20);"Intensity";TAB(35);"Line#"
  116. 3910 PRINT "-------";TAB(11);"----"; TAB(20);"---------";TAB(35);"-----"
  117. 3912 IF I>1 THEN 3920
  118. 3915 IF IPRINT=1 THEN LPRINT "-------";TAB(11);"----"; TAB(20);"---------";TAB(35);"-----"
  119. 3920 RETURN
  120. 4000 CLS:PRINT:PRINT"Spectral parameters:":PRINT:PRINT
  121. 4002 GOSUB 800
  122. 4004 CLS:PRINT:PRINT"Chemical shifts:"
  123. 4005 IF IPRINT=1 THEN LPRINT:LPRINT:LPRINT"Spectral parameters and other input data for this data set:":LPRINT
  124. 4006 IF IPRINT=1 THEN LPRINT:LPRINT"Chemical shift information:"
  125. 4010 PRINT:PRINT"Spectrometer frequency: ";FR;" MHz"
  126. 4015 IF IPRINT = 1 THEN LPRINT:LPRINT"Spectrometer frequency: ";FR;" MHz"
  127. 4020 PRINT:PRINT:PRINT" #";TAB(12);"ppm";TAB(24);"Hz":PRINT"--";TAB(12);"---";        TAB(22);"------"
  128. 4025 IF IPRINT=1 THEN LPRINT:LPRINT:LPRINT" #";TAB(12);"ppm";TAB(24);"Hz":LPRINT"--";TAB(12);"---";        TAB(22);"------"
  129. 4030 FOR I = 1 TO NS
  130. 4040 PRINT I;TAB(10);:PRINT USING "##.###";SH(I);:PRINT TAB(21);:                     PRINT USING "####.##";PM(I,I)
  131. 4045 IF IPRINT=1 THEN LPRINT I;TAB(10);:LPRINT USING "##.###";SH(I);:LPRINT TAB(21);:LPRINT USING "####.##";PM(I,I)
  132. 4050 NEXT
  133. 4060 GOSUB 63999
  134. 4070 CLS:PRINT:PRINT"Coupling constants:":PRINT
  135. 4075 IF IPRINT=1 THEN LPRINT:LPRINT:LPRINT"Coupling constants:":LPRINT
  136. 4080 PRINT " # ";TAB(6);
  137. 4082 IF IPRINT=1 THEN LPRINT " # ";TAB(6);
  138. 4084 FOR I = 1 TO NS: PRINT USING "     #    ";I;
  139. 4086 IF IPRINT=1 THEN LPRINT USING "     #    ";I;
  140. 4088 NEXT
  141. 4090 PRINT:PRINT TAB(6);
  142. 4092 IF IPRINT=1 THEN LPRINT: LPRINT TAB(6);
  143. 4094 FOR I = 1 TO NS: PRINT" ---------";
  144. 4096 IF IPRINT=1 THEN LPRINT" ---------";
  145. 4098 NEXT
  146. 4100 PRINT
  147. 4102 IF IPRINT=1 THEN LPRINT
  148. 4104 FOR I = 1 TO NS
  149. 4106 PRINT USING " #";I;:PRINT TAB(6);
  150. 4108 IF IPRINT=1 THEN LPRINT USING " #";I;:LPRINT TAB(6);
  151. 4110 FOR J = 1 TO NS
  152. 4112 IF I=J THEN PRINT"    ------"; ELSE PRINT USING "#######.##";PM(I,J);
  153. 4114 IF I=J AND IPRINT=1 THEN LPRINT"    ------";
  154. 4116 IF I<>J AND IPRINT=1 THEN LPRINT USING "#######.##"; PM(I,J);
  155. 4118 NEXT
  156. 4120 IF IPRINT=1 THEN LPRINT
  157. 4122 PRINT
  158. 4124 NEXT
  159. 4140 PRINT:PRINT"Listing of parameters completed.":GOTO 63999
  160. 5000 CLS:PRINT:PRINT"Ready to retrieve information from disk.":PRINT
  161. 5005 BF = 0
  162. 5010 PRINT"Do you need to specify the data set name? ";:GOSUB 500
  163. 5012 IF P$ = "Y" THEN 5020 ELSE IF P$ = "N" THEN 5100 ELSE BEEP: GOTO 5010
  164. 5020 PRINT:INPUT"Enter data set name:  ",FF$
  165. 5100 PRINT:PRINT"Now reading in the following:":PRINT
  166. 5110 DF$ = FF$ + ".0": PRINT TAB(5);DF$
  167. 5120 OPEN DF$ FOR INPUT AS 1
  168. 5130 INPUT #1,NS: INPUT #1,FR
  169. 5140 FOR I = 1 TO NS: INPUT #1,SH(I): INPUT #1,PM(I,I): NEXT
  170. 5150 FOR I = 1 TO NS-1: FOR J = I+1 TO NS: INPUT #1, PM(I,J): PM(J,I) = PM(I,J):      NEXT:NEXT
  171. 5151 NF = 2^NS
  172. 5155 FOR I = 1 TO NF: FOR J = 1 TO NS: INPUT #1,SF(I,J): NEXT:NEXT
  173. 5160 CLOSE 1
  174. 5170 DF$ = FF$ + ".inf":PRINT TAB(5);DF$
  175. 5180 OPEN DF$ FOR INPUT AS 1
  176. 5190 INPUT #1,NS: INPUT #1,NF
  177. 5200 FOR I = 0 TO NS: INPUT #1,BC(I): NEXT
  178. 5210 FOR I = 1 TO NS + 1: INPUT #1, FZ(I): NEXT
  179. 5220 CLOSE 1
  180. 5230 NL = 0
  181. 5240 FOR I = 1 TO NS: NL = NL + BC(I-1)*BC(I): NEXT
  182. 5250 DF$ = FF$ + ".lin":PRINT TAB(5);DF$
  183. 5260 OPEN DF$ FOR INPUT AS 1
  184. 5270 TI = 0
  185. 5280 FOR I = 1 TO NL
  186. 5290 INPUT #1,SLINES(I,0)
  187. 5300 INPUT #1,SLINES(I,1): INPUT #1,SLINES(I,2)
  188. 5310 TI = TI + SLINES(I,2): NEXT
  189. 5320 CLOSE 1
  190. 5330 IF BF <> 0 THEN RETURN
  191. 5340 PRINT:PRINT"Reading from disk completed.":PRINT: GOTO 63999
  192. 6000 CLS:PRINT:PRINT"Ready to retrieve lines from disk.  If unsorted lines remain on disk, this is":PRINT" the same as unsorting.":PRINT
  193. 6010 BF=1: GOSUB 63999
  194. 6020 DF$ = FF$ + ".lin": PRINT "Retrieving ";DF$
  195. 6030 GOSUB 5260
  196. 6040 BF = 0
  197. 6050 PRINT:PRINT"Retrieval completed.":GOTO 63999
  198. 10000 CLS:PRINT:PRINT"Routine to display particular lines."
  199. 10010 PRINT:PRINT"Note that values are not rounded off in this routine--you are not getting":PRINT" results in a tabular form!":PRINT
  200. 10020 PRINT"Submenu of three commands:":PRINT
  201. 10030 PRINT TAB(5);"'N'--Display by current line number."
  202. 10040 PRINT TAB(5);"'T'--Select by transition indices."
  203. 10050 PRINT TAB(5);"'Q'--Exit from this routine.":GOSUB 63999
  204. 10055 CLS:PRINT:PRINT"Sub-command (N, T, or Q):  ";: GOSUB 500
  205. 10060 GOSUB 63999
  206. 10070 IF P$ = "N" THEN GOSUB 10100
  207. 10080 IF P$ = "T" THEN GOSUB 10500
  208. 10090 IF P$ = "Q" THEN 200 ELSE 10055
  209. 10100 CLS:PRINT:PRINT"Printing individual lines.  To exit, hit <Return>.":PRINT
  210. 10110 PRINT: INPUT"Enter line number: ",I
  211. 10120 IF I = 0 THEN 10055
  212. 10130 IF I > 0 AND I <= NL THEN 10150
  213. 10140 BEEP: PRINT"Illegal value!  Try again!": GOTO 10110
  214. 10150 PRINT "Transition: ";
  215. 10160 SL = SLINES(I,0): SM = 1000*(SL - INT(SL)): SL = INT(SL): SM = INT(SM+.1)
  216. 10170 PRINT SL;">";SM
  217. 10180 PRINT "Frequency =";SLINES(I,1)
  218. 10190 PRINT "Intensity =";SLINES(I,2): GOTO 10110
  219. 10500 CLS:PRINT:PRINT"Examine lines by transition numbers.":PRINT
  220. 10510 PRINT "Enter the individual functions numbers as requested.  Terminate by entering":PRINT" a <Return> for either.  Order of entry is unimportant.":PRINT
  221. 10520 GOSUB 63999
  222. 10530 CLS:PRINT
  223. 10540 PRINT:INPUT"Enter index #1: ",L
  224. 10550 IF L = 0 THEN 10055
  225. 10560 IF L > 0 AND L <= NF THEN 10580
  226. 10570 BEEP:PRINT"Illegal index!  Try again!": GOTO 10540
  227. 10580 INPUT"Enter index #2: ",M
  228. 10590 IF M = 0 THEN 10055
  229. 10600 IF M > 0 AND M <= NF THEN 10620
  230. 10610 BEEP:PRINT"Illegal index!  Try again!": GOTO 10580
  231. 10620 IF L < M THEN TT = M + L/1000 ELSE TT = L + M/1000
  232. 10630 I = 1
  233. 10640 IF ABS(TT - SLINES(I,0)) < .00001 THEN 10700
  234. 10650 I = I + 1: IF I <= NL THEN 10640
  235. 10660 BEEP: PRINT "No such transition!": GOTO 10540
  236. 10700 PRINT:PRINT"Line number:";I
  237. 10710 PRINT "Frequency =";SLINES(I,1)
  238. 10720 PRINT "Intensity =";SLINES(I,2)
  239. 10730 PRINT: GOTO 10540
  240. 14000 CLS:PRINT:PRINT"Routine to display particular sub-block of eigenvalues and eigenvectors.":PRINT
  241. 14010 PRINT"Possible sub-blocks: 1 to";NS+1: PRINT
  242. 14015 GOSUB 800
  243. 14016 IF IPRINT=1 THEN LPRINT:LPRINT"Eigenvalues and eigenvectors:":LPRINT
  244. 14020 INPUT"Enter sub-block number (exit with <Return>): ",IB: PRINT:                  IF IB = 0 THEN RETURN
  245. 14030 LL = 1: IF IB > NS + 1 THEN BEEP: PRINT "Illegal value!  Try again!":            GOTO 14020
  246. 14035 IF IB = 1 THEN 14050
  247. 14040  FOR I = 1 TO IB - 1: LL = LL + BC(I-1): NEXT
  248. 14050 DF$ = FF$ + "." + RIGHT$(STR$(IB),LEN(STR$(IB))-1):                              OPEN DF$ FOR INPUT AS 1
  249. 14060 INPUT #1, N
  250. 14070 FOR I = 1 TO N: INPUT #1, E(I): NEXT
  251. 14080 IF N > 1 THEN 14090
  252. 14085 A(1,1) = 1: GOTO 14100
  253. 14090 FOR J = 1 TO N: FOR I = 1 TO N: INPUT #1, A(I,J): NEXT: NEXT
  254. 14100 CLOSE 1
  255. 14105 FOR KK = 1 TO N STEP 7
  256. 14110 CLS: PRINT: PRINT"Sub-block number";IB:PRINT:PRINT"Func";TAB(10);
  257. 14112 IF IPRINT=1 THEN LPRINT:LPRINT:LPRINT"Sub-block number";IB;
  258. 14113 IF IPRINT=1 AND KK > 1 THEN LPRINT"(continued)" ELSE                             IF IPRINT=1 THEN LPRINT
  259. 14114 IF IPRINT=1 THEN LPRINT:LPRINT"Func";TAB(10);
  260. 14115 IX = KK + 6: IF IX > N THEN IX = N
  261. 14120 FOR I = KK TO IX: NN = LL + I - 1
  262. 14125 PRINT USING "  ###     ";NN;
  263. 14126 IF IPRINT=1 THEN LPRINT USING "  ###     ";NN;
  264. 14127 NEXT
  265. 14130 PRINT: PRINT "----";TAB(10);
  266. 14131 IF IPRINT=1 THEN LPRINT:LPRINT "----";TAB(10);
  267. 14140 FOR I = KK TO IX: PRINT "--------  ";
  268. 14141 IF IPRINT=1 THEN LPRINT "--------  ";
  269. 14142 NEXT
  270. 14145 PRINT: IF IPRINT=1 THEN LPRINT
  271. 14150 FOR I = 1 TO N: II = LL + I - 1
  272. 14160 FOR J = 1 TO NS
  273. 14170 IF SF(II,J) > 0 THEN PRINT "+";: IF IPRINT=1 THEN LPRINT "+";
  274. 14180 IF SF(II,J) < 0 THEN PRINT "-";: IF IPRINT=1 THEN LPRINT "-";
  275. 14190 NEXT
  276. 14200 PRINT TAB(8);: IF IPRINT = 1 THEN LPRINT TAB(8);
  277. 14210 FOR J = KK TO IX
  278. 14220 A = A(I,J)
  279. 14230 PRINT USING "###.######";A;:IF IPRINT=1 THEN LPRINT USING "###.######";A;
  280. 14235 NEXT
  281. 14240 PRINT: IF IPRINT=1 THEN LPRINT
  282. 14245 NEXT
  283. 14250 PRINT TAB(10);: IF IPRINT=1 THEN LPRINT TAB(10);
  284. 14254 FOR I = KK TO IX: PRINT"--------  ";
  285. 14256 IF IPRINT=1 THEN LPRINT"--------  ";
  286. 14258 NEXT
  287. 14259 PRINT: IF IPRINT=1 THEN LPRINT
  288. 14260 PRINT"E-vals:";TAB(8);: IF IPRINT=1 THEN LPRINT"E-vals:";TAB(8);
  289. 14262 FOR I = KK TO IX: PRINT USING "#######.##";E(I);
  290. 14264 IF IPRINT=1 THEN LPRINT USING "#######.##";E(I);
  291. 14265 NEXT
  292. 14267 PRINT: IF IPRINT=1 THEN LPRINT
  293. 14270 GOSUB 63999
  294. 14275 NEXT
  295. 14290 CLS:PRINT: GOTO 14020
  296. 15000 CLS:PRINT:PRINT"Trans";TAB(10);"Freq";TAB(25);"Intensity"
  297. 15010 PRINT"-----";TAB(10);"----";TAB(25);"---------"
  298. 15020 RETURN
  299. 16000 CLS:PRINT:PRINT"Pause flag is currently ";
  300. 16010 IF IPFLAG = 1 THEN PRINT "ON." ELSE PRINT "OFF."
  301. 16020 PRINT:PRINT"Do you wish to alter the state of the pause flag? ";                 : GOSUB 500
  302. 16030 IF P$ = "N" THEN RETURN ELSE IF P$ <> "Y" THEN 16020
  303. 16040 IF IPFLAG = 0 THEN IPFLAG = 1 ELSE IPFLAG = 0
  304. 16050 RETURN
  305. 18000 CLS:PRINT:PRINT"Auto-read flag is currently ";
  306. 18010 IF IREAD = 0 THEN PRINT "OFF" ELSE PRINT "ON"
  307. 18020 PRINT:PRINT"Do you wish to alter its status? ";: GOSUB 500
  308. 18030 IF P$ = "N" THEN 63999
  309. 18040 IF P$ <> "Y" THEN BEEP: GOTO 18000
  310. 18050 IF IREAD = 0 THEN IREAD = 1 ELSE IREAD = 0
  311. 18060 GOTO 63999
  312. 19000 CLS:PRINT:PRINT"Routine for entering thresholds.":PRINT
  313. 19010 PRINT"Rules:  Prints all lines between THRESHOLD1 & THRESHOLD2."
  314. 19020 PRINT"        Set THRESHOLD1 for minimum intensity to print."
  315. 19030 PRINT"        Set THRESHOLD2 for maximum intensity to print."
  316. 19040 PRINT
  317. 19050 PRINT"        Set both = 0 to print all lines."
  318. 19060 PRINT"        Set THRESHOLD2 = 0 to print all lines above THRESHOLD1."
  319. 19070 PRINT
  320. 19080 INPUT"Enter THRESHOLD1:  ",THRESHOLD1
  321. 19090 INPUT"Enter THRESHOLD2:  ",THRESHOLD2
  322. 19100 IF THRESHOLD1 > 0 AND THRESHOLD2 = 0 THEN THRESHOLD2 = 1.00001
  323. 19110 GOTO 63999
  324. 20000 CLS:PRINT:PRINT"Now sorting lines from highest to lowest frequencies (NMR convention).":PRINT
  325. 20005 FOR I = 1 TO NL - 1
  326. 20006 PRINT ".";
  327. 20010 SM = SLINES(I,1): IS = I
  328. 20020 FOR J = I + 1 TO NL
  329. 20030 IF SLINES(J,1) < SM THEN 20050
  330. 20040 IS = J: SM = SLINES(J,1)
  331. 20050 NEXT
  332. 20060 IF IS = I THEN 20100
  333. 20070 FOR K = 0 TO 2: SWAP SLINES(I,K),SLINES(IS,K): NEXT
  334. 20100 NEXT
  335. 20110 PRINT:PRINT"Sorting completed.": PRINT:PRINT"You now have the option of storing the sorted lines on the disk.  Note that":PRINT" this destroys the unsorted lines and reduces the precision!":PRINT
  336. 20120 PRINT:PRINT"Put sorted lines on disk? ";: GOSUB 500
  337. 20130 IF P$ = "N" THEN 63999
  338. 20135 IF P$ <> "Y" THEN 20120
  339. 20140 PRINT:PRINT"Are you absolutely sure? ";: GOSUB 500
  340. 20142 IF P$ = "N" THEN 63999
  341. 20144 IF P$ <> "Y" THEN 20120
  342. 20150 PRINT:PRINT"Now replacing unsorted lines with sorted lines!":PRINT
  343. 20160 DF$ = FF$ + ".lin": OPEN DF$ FOR OUTPUT AS 2
  344. 20170 FOR I = 1 TO NL
  345. 20180 PRINT #2, CDBL(SLINES(I,0))
  346. 20190 PRINT #2, CDBL(SLINES(I,1))
  347. 20200 PRINT #2, CDBL(SLINES(I,2))
  348. 20210 NEXT
  349. 20220 CLOSE 2
  350. 20230 PRINT:PRINT"Storage of sorted lines completed.  Unsorted lines destroyed."      : PRINT: GOTO 63999
  351. 60000 PRINT: BEEP: PRINT"Error encountered!  Check that needed files have been read in!": GOSUB 63999
  352. 60010 CLOSE 1,2
  353. 60020 RESUME 100
  354. 63999 IF IPFLAG = 1 THEN RETURN ELSE PRINT:INPUT"Hit <Return> to continue.",A$:        :RETURN
  355.